home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / MultiSel / BMListU1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-03-25  |  4.4 KB  |  191 lines
  1. unit BMListU1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, ComCtrls, StdCtrls,
  8.   Buttons;
  9.  
  10. type
  11.   TfrmMain = class(TForm)
  12.     Table1: TTable;
  13.     DataSource1: TDataSource;
  14.     Timer1: TTimer;
  15.     StatusBar1: TStatusBar;
  16.     Database1: TDatabase;
  17.     GroupBox1: TGroupBox;
  18.     btnParadox: TBitBtn;
  19.     btnInterbase: TBitBtn;
  20.     btnOpenClose: TBitBtn;
  21.     GroupBox2: TGroupBox;
  22.     btnDeleteSelections: TBitBtn;
  23.     btnSelectCurrent: TBitBtn;
  24.     btnCopySelect: TBitBtn;
  25.     GroupBox3: TGroupBox;
  26.     DBNavigator1: TDBNavigator;
  27.     DBGrid1: TDBGrid;
  28.     GroupBox4: TGroupBox;
  29.     ListBox1: TListBox;
  30.     procedure StatusBar1Resize(Sender: TObject);
  31.     procedure FormResize(Sender: TObject);
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure Timer1Timer(Sender: TObject);
  34.     procedure FormShow(Sender: TObject);
  35.     procedure FormHide(Sender: TObject);
  36.     procedure btnOpenCloseClick(Sender: TObject);
  37.     procedure btnSelectCurrentClick(Sender: TObject);
  38.     procedure btnCopySelectClick(Sender: TObject);
  39.     procedure btnParadoxClick(Sender: TObject);
  40.     procedure btnInterbaseClick(Sender: TObject);
  41.     procedure btnDeleteSelectionsClick(Sender: TObject);
  42.   private
  43.         { Private declarations }
  44.         fborderwidth:integer;
  45.     public
  46.     { Public declarations }
  47.     end;
  48.  
  49. var
  50.   frmMain: TfrmMain;
  51.  
  52. implementation
  53.  
  54. uses ProgressFrm;
  55.  
  56. {$R *.DFM}
  57.  
  58. procedure TfrmMain.StatusBar1Resize(Sender: TObject);
  59. begin
  60.     // Resize the left hand panel.
  61.     StatusBar1.Panels[0].Width:=frmMain.ClientWidth-30;
  62. end;
  63.  
  64. procedure TfrmMain.FormResize(Sender: TObject);
  65. var
  66.     i:integer;
  67. begin
  68.     i:=Listbox1.Left+Listbox1.width+10;
  69.     with TfrmMain(Sender) do
  70.     begin
  71.         if (width -FBorderWidth)<i then
  72.             Width:=i + FBorderWidth;
  73.     end;
  74. end;
  75.  
  76. procedure TfrmMain.FormCreate(Sender: TObject);
  77. begin
  78.     if sender is TfrmMain then
  79.     with TfrmMain(Sender) do
  80.         fborderwidth:=(Width-ClientWidth);
  81. end;
  82.  
  83. procedure TfrmMain.Timer1Timer(Sender: TObject);
  84. begin
  85.     StatusBar1.Panels[1].Text:=IntToStr(DBGrid1.SelectedRows.Count);
  86. end;
  87.  
  88. procedure TfrmMain.FormShow(Sender: TObject);
  89. begin
  90.     Timer1.Enabled:=True;
  91. end;
  92.  
  93. procedure TfrmMain.FormHide(Sender: TObject);
  94. begin
  95.     Timer1.Enabled:=False;
  96. end;
  97.  
  98. procedure TfrmMain.btnOpenCloseClick(Sender: TObject);
  99. begin
  100.     try
  101.         Table1.Active:=not Table1.Active;
  102.         if (not Table1.Active) and (table1.DatabaseName='d1') then
  103.             Database1.Connected:=False;
  104.     except
  105.         MessageDlg('Select a table first',mtError,[mbOK],0);
  106.     end;
  107. end;
  108.  
  109. procedure TfrmMain.btnSelectCurrentClick(Sender: TObject);
  110. begin
  111.     with DBGrid1.SelectedRows do
  112.         CurrentRowSelected:=not CurrentRowSelected;
  113. end;
  114.  
  115. procedure TfrmMain.btnDeleteSelectionsClick(Sender: TObject);
  116. begin
  117.     DBGrid1.SelectedRows.Delete;
  118. end;
  119.  
  120. procedure TfrmMain.btnCopySelectClick(Sender: TObject);
  121.     procedure    AddToList;
  122.     var
  123.         i:integer;
  124.         s:string;
  125.     begin
  126.         with DBGrid1.DataSource.DataSet do
  127.         for i:=0 to FieldCount-1 do
  128.         begin
  129.             if (i>0) then
  130.                 s:=s+', ';
  131.             s:=s+Fields[i].AsString;
  132.         end;
  133.         Listbox1.Items.Add(s);
  134.     end;
  135. var
  136.     i:integer;
  137.     MyBookmark:TBookmark;
  138. begin
  139.     Listbox1.Clear;
  140.     MyBookmark:=Nil;
  141.     if DBGrid1.SelectedRows.Count>0 then
  142.     try
  143.         frmProgress.Max:=DBGrid1.SelectedRows.Count;
  144.         frmProgress.Progress:=0;
  145.         frmProgress.Show;
  146.         with DBGrid1.DataSource.DataSet do
  147.         begin
  148.             MyBookmark:=GetBookmark;
  149.             for i:=0 to DBGrid1.SelectedRows.Count-1 do
  150.             begin
  151.                 GotoBookmark(pointer(DBGrid1.SelectedRows.Items[i]));
  152.                 AddToList;
  153.                 frmProgress.Inc;
  154.             end;
  155.             GotoBookmark(MyBookmark);
  156.         end;
  157.     finally
  158.         frmProgress.Hide;
  159.         if Assigned(MyBookmark) then
  160.             DBGrid1.DataSource.DataSet.FreeBookmark(MyBookmark);
  161.     end;
  162. end;
  163.  
  164. procedure TfrmMain.btnParadoxClick(Sender: TObject);
  165. begin
  166.     if Table1.Active then btnOpenClose.Click;
  167.     with Table1 do
  168.     begin
  169.         DatabaseName:=ExtractFilePath(Application.ExeName);
  170.         TableName:='Animal.db';
  171.         TableType:=ttParadox;
  172.     end;
  173. end;
  174.  
  175. procedure TfrmMain.btnInterbaseClick(Sender: TObject);
  176. begin
  177.     if Table1.Active then btnOpenClose.Click;
  178.   if Database1.Connected then Database1.Connected:=False;
  179.     Database1.Params.Values['SERVER NAME']:=ExtractFilePath(Application.ExeName)
  180.             +'Animals.gdb';
  181.     with Table1 do
  182.     begin
  183.         DatabaseName:='d1';
  184.         TableName:='Animals';
  185.         TableType:=ttDefault;
  186.     end;
  187. end;
  188.  
  189. end.
  190.  
  191.